#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
use Glib qw(TRUE FALSE);
use Digest::MD5 qw(md5_hex);
use Pod::Usage;

use vars qw($VERSION $NAME $ID);

#note shelltitle
#--------------------------------------------------
# echo -ne '\ekcommand-line\e\\' screen
# print "\033]0;hallo\007";' rxvt
#-------------------------------------------------- 



$NAME = "ompupload.pl";
$ID   = q$Id: ompupload.pl 8 2009-10-26 10:03:04Z ir0n1e@freenet.de $;

my (
    $head,  $psyn,  $help, 
    $force, $paste, $pipe,    $version, $noconfig,
   ) = FALSE;

my %set = (
    bbcode => FALSE,
    no_data => FALSE,
    url_only => FALSE,
    quiet => FALSE,
);
   
   
my @syntax = (
              ["raw",  "c",      "cobol",      "cpp"],
              ["css",  "diff",   "fortran",    "haskell"],
              ["html", "java",   "javascript", "lisp"],
              ["lua",  "mysql",  "pascal",     "perl"],
              ["php",  "python", "ruby",       "scheme"],
              ["sh",   "vb",     "xhtml",      "xml"]
             );

my $default_syntax = 'raw';
my $syntax         = '';
my $filename       = 'paste';
my (@files, @stdin);
my $confdir  = "$ENV{HOME}/.ompupload";
my $database = "$confdir/ompupload.db";
my $config  = "$confdir/ompupload.conf";
my $date     = sprintf("%04d-%02d-%02d",
                   ((localtime)[5] + 1900),
                   ((localtime)[4] + 1),
                   (localtime)[3]);

my $exists   = FALSE;
my $errors   = 0;
my $warnings = 0;
my $wait     = 5;
my $Url      = 'http://omploader.org/';
my $Max_size = 2**30;
my $first    = TRUE;
my $nocurl   = FALSE;
my $curl     = qx(curl --version 2> /dev/null);

if (!$curl)
{
    $nocurl = TRUE;
    print STDERR "Error: curl missing or not in path.  Cannot continue.\n";
}

sub version ()
{
    $VERSION = join(' ', (split(' ', $ID))[1 .. 3]);
    $VERSION =~ s/,v\b//;
    $VERSION =~ s/(\S+)$/($1)/;
    die ' ', $VERSION, "\n\n";
}

sub read_config()
{
    my ($val,$key);
    return if (! -e $config);

    open(FILE,'<'.$config);
    
    foreach my $line (<FILE>)
    {
        chomp($line);
        next if($line =~ /^\s*#/);
        
        $line =~ s/\s*=\s*/=/;
        
        if ($line =~ /(.*)=(.*)/mg)
        {
            $key = $1;
           
            $set{$key} = eval uc($2);
        }
    }    
}

    





sub format_list (@)
{
    my $entries;
    my @len;
    my (@array) = @_;
    foreach my $row (@array)
    {
        return if ref($row) ne 'ARRAY';

        my $i = 0;
        foreach my $column (@{$row})
        {
            my $row_length    = length(@{$row});
            my $column_length = length($column);

            if ($entries)
            {
                return if $entries != $row_length;
            }
            else
            {
                $entries = $row_length;
            }
            $len[$i] = -1 if !$len[$i];

            $len[$i] = $column_length if $column_length > $len[$i];
            $i++;
        }
    }
    my @a;
    my $format = join(' | ', map { '%-' . $_ . 's' } @len);
    if ($head)
    {
        my $b;
        @a = map { sprintf(' | ' . $format . ' |', @{$_}) } $array[0];

        foreach (0 .. (length($a[0])))
        {
            $b .= '=';
        }
        push(@a, $b);
        shift(@array);
        push(@a, map { sprintf(' | ' . $format . ' |', @{$_}) } @array);
        push(@a, $b);
    }
    else
    {
        @a = map { sprintf(' | ' . $format . ' |', @{$_}) } @array;

        foreach (0 .. (length($a[0])))
        {
            $b .= '=';
        }

        unshift(@a, $b);
        push(@a, $b);
    }
    return @a;
}

sub help_syntax()
{
    my @table = &format_list(@syntax);

    print " Valid syntax options are:\n";

    foreach (@table)
    {
        print "  $_\n";
    }

    exit;
}

sub check_syntax($)
{
    my ($i) = @_;
    my $false = TRUE;

    $i = $default_syntax if $i eq '';

    foreach my $row (@syntax)
    {
        foreach (@$row)
        {
            if ($_ eq $i)
            {
                $syntax = $i;
                $false  = FALSE;
                last;
            }
        }
    }

    if ($false)
    {
        $syntax = $default_syntax;
        print STDERR
          " $i is not a valid syntax option. Taking default: $syntax.\n";
        print STDERR " $NAME --helpsyntax syntax for valid options.\n";
        $warnings += 1;
    }
}

my $man = 0;

GetOptions(
           'help|?'     => \$help,
           'man'        => \$man,
           'helpsyntax' => \$psyn,
           'url|u'      => \$set{url_only},
           'force|f'    => \$force,
           'oneshot|1'  => \$set{no_data},
           'quiet|q'    => \$set{quiet},
           'paste|p'    => \$paste,
           'syntax|s=s' => \$syntax,
           'paste|p'    => \$paste,
           'printdata'  => \&print_database,
           'bbcode|b'   => \$set{bbcode},
           'version'    => \$version,
           'noconfig'   => \$noconfig,
          ) or pod2usage(-verbose => 0);

&help_syntax() if $psyn;
&version()     if $version;
pod2usage(-verbose => 1) if $help;
pod2usage(-verbose => 2) if $man;
## If no arguments were given, then allow STDIN to be used only
## if it's not connected to a terminal (otherwise print usage)
pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
#exit;

&read_config() if not $noconfig;
foreach my $key ( keys %set )
{
  print "key: " . $key . " value: " . $set{$key} . "\n";
}

# check if we have a pipe
if (-p STDIN)
{
    @stdin = <STDIN>;
    if ($paste)
    {
        unshift(@ARGV, 'stdin');
        $pipe = TRUE;
    }
    else
    {
        print "@stdin\n";
        chomp(@stdin);
        unshift(@ARGV, @stdin);
    }
}

&check_syntax($syntax);

# make configdir
if (!-e $confdir)
{
    mkdir($confdir, 0777);
}

sub print_database()
{
    my (@line, @table, @data);

    open(DATA, '<' . $database);
    push(@table, ['Date', 'File', 'Url', 'MD5']);

    while (<DATA>)
    {
        chomp;
        @line = split(/§/, $_);

        my @lin = ($line[0], $line[1], $Url . 'v' . $line[2], $line[3]);
        push(@table, \@lin);
    }

    $head = TRUE;
    @data = &format_list(@table);
    foreach (@data)
    {
        print "$_\n";
    }

    exit;
}

sub read_data($)
{
    my ($arg) = @_;
    my $md5 = md5_hex($arg);
    open(DATA, '<' . $database);

    if ($force)
    {
        my @data = <DATA>;
        @data = grep { !/$md5$/i } @data;
        return (@data);
    }

    while (<DATA>)
    {
        chomp;
        my @line = split(/§/, $_);

        if ($line[3] eq "$md5")
        {
            print STDERR $line[1] . ' was uploaded at ' . $line[0] . "\n"
              if not $set{quiet} and not $set{url_only};
            print $Url . 'v' . $line[2] . "\n" if not $set{quiet};
            print 'BBCode: [URL=' 
              . $Url . 'v'
              . $line[2]
              . '][IMG]'
              . $Url . 't'
              . $line[2]
              . "[/IMG][/URL]\n"
              if $set{bbcode}
                  and not $set{quiet}
                  and not $paste;

            $warnings += 1;
            $exists = TRUE;
            last;
        }
    }
    close DATA;
}

sub write_data($$)
{
    my ($arg, $id) = @_;
    my $md5 = md5_hex($arg);

    if ($force)
    {
        my @data = read_data($arg);
        open(DATA, '>' . $database);
        print DATA @data;
    }

    open(DATA, '>>' . $database);
    print DATA $date . '§' . $arg . '§' . $id . '§' . $md5 . "\n"
      if not $set{no_data};
    
      close DATA;
    $exists = FALSE;
}

my $counter = 1;
my $count = ($#ARGV + 1);

foreach my $arg (@ARGV)
{
    if (!$pipe and (!-e $arg))
    {
        print STDERR
          "Invalid argument $arg: file does not exist (or is not a regular file).\n";
        $errors += 1;
        next;
    }
    elsif (!$pipe and (-s $arg) > $Max_size)
    {
        my $size = (-s $arg);
        print STDERR
          "Error omploading $arg: file exceeds $Max_size  bytes (size was $size).\n";
        $errors += 1;
        next;
    }

    if (!$first and not $exists)
    {

        # try not to hammer the server
        print "Sleeping for $wait s\n" if not $set{quiet} and not $set{url_only};
        sleep($wait);
    }
    else
    {
        $first = FALSE;
    }
    if (!$pipe and $paste)
    {
        open(PASTE, '<', $arg);
        @stdin = <PASTE>;
        $pipe  = TRUE;
    }

    my $rand = rand(100);
    my $tmp  = '/tmp/' . $filename . $date . $rand;
    print "Status: [$counter/$count]\nProgress for $arg\n" if not $set{quiet} and not
    $set{url_only};

    if ($pipe)
    {
        if ($set{quiet} or $set{url_only})
        {
            open(PIPE,
                " | curl -is -F 'paste=<-' -F 'syntax=$syntax' ${Url}upload -o $tmp"
            );
        }
        else
        {
            open(PIPE,
                " | curl -i -F 'paste=<-' -F 'syntax=$syntax' ${Url}upload -o $tmp"
            );
        }
        print PIPE @stdin;
        close PIPE;
        $pipe = FALSE;
    }
    else
    {
        read_data($arg)
          if (-e $database)
          and not $set{no_data}
          and not $force
          and not $pipe;

        next if $exists;

        # escape quotes
        $arg =~ s/"/\"/g;
        if ($set{quiet} or $set{url_only})
        {
            qx(curl -s -F file1=@"$arg" $Url'/upload' -o $tmp);
        }
        else
        {
            qx(curl  -F file1=@"$arg" $Url'/upload' -o $tmp);
        }
    }

    if ((!-e $tmp) or (-s $tmp) eq '0')
    {
        print STDERR "Error omploading $arg\n";
        $errors += 1;
        next;
    }

    my ($output, $id);

    open(FILE, '<' . $tmp);

    # parse for an ID
    foreach $output (<FILE>)
    {
        if ($output =~ /View file: <a href="v([A-Za-z0-9+\/]+)">/mg)
        {
            $id = $1;
            print 'Omploaded ' . $arg . ' to ' . $Url . 'v' . $id . "\n"
              if not $set{quiet};

            print 'BBCode: [URL=' 
              . $Url . 'v' 
              . $id 
              . '][IMG]' 
              . $Url . 't'
              . $id
              . "[/IMG][/URL]\n"
              if $set{bbcode}
                  and not $set{quiet}
                  and not $paste;

            #write file to database
            write_data($arg, $id) if not $set{no_data};

            $wait = 5;
            $counter++;
            last;
        }
        elsif ($output =~ /Slow down there, cowboy\./)
        {
            $wait += 60;
            push(@ARGV, $arg);
            print "Got throttled when trying to ompload $arg\n";
            print "Increasing wait and attempting to continue...\n";
            $errors += 1;

            last;
        }
    }
    close FILE;
    unlink($tmp);
}

if (!$set{quiet} and !$set{url_only})
{
    if ($errors < 1 && $warnings < 1)
    {
        print "Success.\n";
    }
    elsif ($warnings && $errors < 1)
    {
        print "Finished with $warnings warnings.\n";
    }
    elsif ($warnings && $errors)
    {
        print "Finished with $errors errors and $warnings warnings.\n";
    }
    else
    {
        print "Finished with $errors errors.\n";
    }
}

__END__

=head1 NAME

ompupload.pl uploads or paste files to http://omploader.org

=head1 VERSION

$Id: ompupload.pl 8 2009-10-26 10:03:04Z ir0n1e@freenet.de $

=head1 AUTHOR

Sascha Bartuweit, E<lt>ir0n1e@freenet.deE<gt>.

=head1 COPYRIGHT

This program is distributed under the Artistic License.

=head1 DESCRIPTION

B<ompupload.pl> will upload or paste files to http://omploader.org
It uses a database to store uploaded files.
You can supply a list of files or data via stdin (or both)
This script requires a copy of cURL in the path.

=head1 SYNOPSIS

B<ompupload.pl> 
[B<-help>] 
[B<-man>] 
[B<-noconfig>]
[B<-version>] 
[B<-helpsyntax>] 
[B<-printdata>] 
[B<-url>]
[B<-quiet>]
[B<-oneshot>]
[B<-bbcode>]
[B<file(s)>]

B<ompupload.pl> 
[B<-paste>]
[B<-syntax=>I<perl>]
[B<-noconfig>]
[B<-version>] 
[B<-help>] 
[B<-man>] 
[B<-printdata>] 
[B<-helpsyntax>] 
[B<-url>]
[B<-quiet>]
[B<file(s)>]

You can supply a list of files or data via stdin (or both)
This script requires a copy of cURL in the path.

=head2 EXAMPLES

=over 4

=item B<Upload File (Default)>

ompupload.pl <I<somefile>> 

ompupload.pl I<-bbcode> I<-oneshot> <I<somefile>> <I<somefile>> <I<somefile>>

=item B<Upload A List Of Files>

cat <I<fileslist>> | oploader.pl

=item B<Paste File>

ompupload.pl -paste <I<somefile>> 

ompupload.pl -paste -syntax=I<perl> <I<somefile>> 

cat <I<somefile>> | ompupload.pl -paste

=back

=cut

=head1 ARGUMENTS

=over 4

=item B<-h, -help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-noconfig> 

Do not read config file.

=item B<-version> 

Prints version.

=item B<-q, -quiet>

Only output errors and warnings

=item B<-u, -url>

Only output URL when finished

=item B<-1, -oneshot>

Don't use Database.

=item B<-f, -force>

Overwrite existing database entry.

=item B<-p, -paste>

Set (no)paste mode

=item B<-b, -bbcode>

Prints BBcode farmated url.

=item B<-printdata>

Prints content of database.

=item B<-helpsyntax>

Prints a list of valid syntax highlight options.

=back

=head2 SYNTAX OPTIONS

    ========================================
    | raw  | c      | cobol      | cpp     |
    | css  | diff   | fortran    | haskell |
    | html | java   | javascript | lisp    |
    | lua  | mysql  | pascal     | perl    |
    | php  | python | ruby       | scheme  |
    | sh   | vb     | xhtml      | xml     |
    ========================================

=head1 CONFIG

Default config file is ~/.ompupload/ompupload.conf

B<Possible values are:> TRUE, FALSE, 0, 1 

=head2 OPTIONS

bbcode      = boolean

no_data     = boolean

url_only    = boolean

quiet       = boolean

B<Note: Commandline options will be overwritten by config options.>

=head1 LICENCE AND COPYRIGHT

Copyright (C) 2009 Sacha Bartuweit 'Ir0n1E' <ir0n1e@freenet.de>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 AVAILABILITY

$HeadURL: https://ompupload.googlecode.com/svn/trunk/ompupload.pl $

=head1 DATE

Okt 26, 2009 11:02:00

=cut

# vi:ts=4:sw=4:ai:expandtab 
